C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.

	IMPLICIT INTEGER(A-Q,S-Z)
	REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
	COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
	1 /RINP/R(10,80),RPOS(2,50),RI(200) 
	2 /RMOD/RMODE2,RSET4,IBEAM,
	3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
	COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
	1 /STF/RSTFAC(0/7),RSTJ2
	2  /POSI/STFF(0/7),JJ2,POS  /ALF/INP(72),ML 
	3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
	4 /IDEV/IDEV,CHNG 
	5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
	2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW 
	1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO 
	2 /MKX/MKX(11) /SC/SSC(72)
	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(I4,
	1 INP(4)),(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
	2 RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
	4 (R11,RJQ(9)),(R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
	5 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
	6 ,(J13,JQ(11)),(IPOS,POS),(I7,INP(7)) ,(ISTAR,MKX(11))
	1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
	DATA RNW/2.44/,LCNT/1/,LIMIT/3000/,DIS/1.0/, RHT/1.0/
	5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,ISEMI/';'/
C THE GIANT NUMBERS ARE FOR [ AND ]
	DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
	1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
C LIMIT IS MAIN ARRAY LENGTH (3000)   /SC/SSC ARRAY USED IN MARKS,BEAMS,SLURS
C  350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)

	IDEV=1
	I1=0
	IX=0
	RSET4=999
	RPOS(1,1)=0
	PWDS(1)=1
	RN(2)=0
C  FOR RESTART.  AVOIDS STAFF CODE NUM.
	DO 30 K=0,7
30	RSTFAC(K)=1.
	M=1
	ITEM=0
	I=1
40	SCORE=-1

C CATCHES TYPO WITH 'C'
130	K=ITEM+1
	TYPE 100 
100	FORMAT(' TYPE FILE NAME  '$)
101	FORMAT(2A5)
	ACCEPT 101,NAME
	IF(NAME.EQ.' ')NAME='INPUT'
	CALL IFILE(1,NAME)
	
	READ(IDEV,700,END=40)INP
	IF(I7.NE.LT)GO TO 320
	IF(I1.NE.LC)GO TO 320
C 'ET' DIRECTORY? UGH!!!
310	READ(IDEV,700)INP
	IF(I3.NE.ISEMI)GO TO 310
	READ(IDEV,700)INP
C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
320	CALL READX
	JA=55

700	FORMAT(72A1)

950	JA=140
	RMODE2=R3
C  ?????  CHECK THIS  TYPE 'IN STF# MODE' ETC.  -- SAME AS 140 STF#.
960	SCORE=0
	IF(JA.NE.140)GO TO 990
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
	RSTF=R2
C DO I NEED THE NEXT???
	ITEM=1
	RN(1)=6
	RN(2)=8.
	RN(3)=R2
	IF(R3.LT.0)R3=0
	RN(4)=R3
	RN(5)=R4
	RN(6)=R5
	RN(7)=R6
	RN(8)=R7
	RN(9)=R8
	IF(R5.EQ.0)R5=1.
	RSTFAC(IFIX(R2))=R5
C P4 ???
	I=10
980	JA=140
C	ITCHK=ITEM
	ICHK=I
C	JIT=ITEM
990	ISC=I
	REND=0
C   RETAINS ORIGINS OF SCORE SQUENCE
1000	IF(REND.EQ.2)GO TO 990
C  FOR READIN CONTINUATION.
	M=ISC
1010	IF(JA.EQ.8)GO TO 980
	IF(REND)GO TO 1050
C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
	CALL SCMSS
	IOLD=0
	IF(REND.EQ.1)GO TO 1050
	IF(REND.NE.99)GO TO 1020
	I=ICHK
C	ITEM=ITCHK
	GO TO 1050
1050	 GO TO 130
CC1020	ITEM=JIT
1020	J=M
1030	ITEM=ITEM+1
	PWDS(ITEM)=J
	J=J+RN(J)+3
	IF(J.LT.I)GO TO 1030
	IF(IBEAM)GO TO 1040
	R2=RSTF
	JA=-1
	CALL HOMX
C GO ADJUST STEM LENGTHS
CC1040	ITEM=JIT
1040	CALL TYPSTR('NAME.EXT? ')
	ACCEPT 700,INP
	CALL NAMEXT(INP,NAME,EXT)
	IF(NAME.EQ.' ')NAME='TMP'
	IF(EXT.EQ.' ')EXT='MS'
41	CALL PUTEXT(NAME,EXT)
	JJ2=ITEM+1
	IPOS=I
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(RN,I)
	CALL FINEXT
	END
	SUBROUTINE DDCLR
	END
	SUBROUTINE RDCUR
	END
	SUBROUTINE PNUM
	END
	SUBROUTINE PRESCN
	END
C	SUBROUTINE JUSTXT
C	END
	SUBROUTINE JUSTFY
	END
C	SUBROUTINE LPEN
C	END
	SUBROUTINE CLRCUR
	END
	SUBROUTINE FILLMS
	END
	SUBROUTINE MAKNUM
	END
	SUBROUTINE SETCUR
	END
	SUBROUTINE LINES(A,B,C)
	END
	SUBROUTINE LO2UP
	END

	SUBROUTINE NAMEXT(I,NAME,IEXT)
C FINDS NAME.EXT IN A1 STRING
	DIMENSION I(1)

	IF(I(1).NE.-1)GO TO 9
C FIRST PASS UP 'G', 'GM', 'RS', ETC.  (=-1)
	DO 1 K=1,72
1	IF(I(K).EQ.' ')GO TO 2
C NOW PASS BLANKS
2	J=72
	DO 3 J=K+1,72
3	IF(I(J).NE.' ')GO TO 4
C NOW FOUND START OF WORD (UNLESS ALL BLANKS)
4	IF(J.NE.72)GO TO 5
	NAME=' '
	RETURN
9	J=1
5	DO 6 K=J,72
	IF(I(K).EQ.' ')GO TO 7
C JUMP IF NAME ONLY
6	IF(I(K).EQ.'.')GO TO 8
7	CALL PACKX(NAME,I(J))
	RETURN
8	CALL RLOOP(I(61),I(J),K-J)
	CALL PACKX(NAME,I(61))
	CALL PACKX(IEXT,I(K+1))
	END

	SUBROUTINE PACKX(NAM,KNM)
	DIMENSION KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/
	NAM=0
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE
	RETURN
	END

	BLOCK DATA
C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
	COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
	1 ISEMI,IDBQT,IBLA,IDOL,IPRCNT,IANPR,IAT,INUM,LESS,IGT,IAPOS,
	1 IQUES,IEXCLA,LBRK,RBRK,UPAR,DNAR,DBLAR,SLA,XX,ZZ,
	1 J4,L,Y,K,RX,RZ,RA,J5 
	COMMON/SCN/KEL,KR,KU,KD,KSLA,NONO(30) /NUM/NUM(10),JRD/MKS/MKS(14)
	DIMENSION IAZ(26),JALPHA(30)
	COMMON/A2Z/LA,LB,LC,LD,LE,LF,LG,LH,LI,LJ,LK,LEL,LM,
	1 LN,LO,LP,LQ,LR,LS,LT,LU,LV,LW,LX,LY,LZ
	2  /POSI/STFF(0/7),JJ2,POS  /STF/RSTFAC(0/7),RSTJ2
	EQUIVALENCE (ICOM,JALPHA),(IAZ,LA)
C	EQUIVALENCE (ICOM,JALPHA),(INP2,INP(2)),(IAZ,LA),(LSQ,JALPHA(23))
	COMMON/FRMT/F78F(1),FONE(1),FA5(1),ASK
	DATA F78F/'(78F)'/,FONE/'(A1 )'/,FA5/'(A5 )'/
	DATA LEL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/,KSLA/'/'/
	1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/,XFONT/50./
	DATA IAZ/'A','B','C','D','E','F','G','H','I','J','K','L','M',
	1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
C	1 ,IBKSL/"561004020100/
C  IBKSL=\   BACKSLASH - NOT USED YET  5/80
	DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
	1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
	1 ,"555004020100,"565004020100,"571004020100,"5004020100,
	1 "135004020100,'/',"755004020100,"771004020100/
	1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
	DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
	DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/
	END